home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / intrfc70.zip / DUMP.PAS < prev    next >
Pascal/Delphi Source File  |  1994-03-16  |  3KB  |  161 lines
  1. unit dump;
  2. {$I SWITCHES.INC}
  3. {  Various routines to dump memory to system.output  }
  4.  
  5. interface
  6.  
  7. procedure dumpbytes(var loc;start,num:word);
  8. procedure dumpwords(var loc;start,num:word);
  9. function decword(w:word):string;
  10. function hexbyte(b:byte):string;
  11. function hexword(w:word):string;
  12. function hexwordblank(w:word):string;
  13. function hexwordasm(w:word):string;
  14.  
  15. implementation
  16.  
  17. uses
  18.   util;
  19.  
  20. function decword(w:word):string;
  21. var S:string;
  22. begin
  23.   Str(w,S);
  24.   decword:=S;
  25. end;
  26.  
  27. function hexbyte(b:byte):string;
  28. const
  29.   symbol : array[0..$f] of char = ('0','1','2','3','4','5','6','7',
  30.                                    '8','9','A','B','C','D','E','F');
  31. begin
  32.   hexbyte := symbol[b shr 4] + symbol[b and $f];
  33. end;
  34.  
  35. function hexword(w:word):string;
  36. begin
  37.   hexword := hexbyte(hi(w))+hexbyte(lo(w));
  38. end;
  39.  
  40. function hexwordblank(w:word):string;
  41. var
  42.   i : byte;
  43.   h : string;
  44. begin
  45.   h := hexword(w);
  46.   for i:=1 to length(h)-1 do
  47.   begin
  48.     if h[i] <> '0' then
  49.     begin
  50.       hexwordblank := h;
  51.       exit;
  52.     end;
  53.     h[i] := ' ';
  54.   end;
  55.   hexwordblank := h;
  56. end;
  57.  
  58. function hexwordasm(w:word):string;
  59. var
  60.   i : byte;
  61.   b : boolean;
  62.   h, h1 : string;
  63. begin
  64.   h := hexword(w);
  65.   b:=false;
  66.   h1[0]:=#0;
  67.   for i := 1 to length(h) do
  68.     if b or (h[i]<>'0') then
  69.     begin
  70.       if not b and (h[i] in ['A'..'F']) then
  71.       begin
  72.         h1[1]:='0';
  73.         Inc(h1[0]);
  74.       end;
  75.       b:=true;
  76.       Inc(h1[0]);
  77.       h1[Ord(h1[0])]:=h[i];
  78.     end;
  79.   Inc(h1[0]);
  80.   h1[Ord(h1[0])]:='h';
  81.   hexwordasm:=h1;
  82. end;
  83.  
  84. function legal(b:byte):char;
  85. begin
  86.   if b<32 then
  87.     legal := '.'
  88.   else
  89.     legal := char(b);
  90. end;
  91.  
  92. procedure dumpbytes(var loc;start,num:word);
  93. var
  94.   bytes:array[0..65520] of byte absolute loc;
  95.   i,j:word;
  96. procedure dumpascii(last:word);
  97. var
  98.   j : word;
  99. begin
  100.   for j:=0 to last do
  101.   begin
  102.     write(legal(bytes[i+start-$F+j]));
  103.   end;
  104. end;
  105. begin
  106.   if num = 0 then
  107.     exit;
  108.   for i:=0 to num-1 do
  109.   begin
  110.     case i mod 16 of
  111.     0: begin
  112.          writeln;
  113.          write(hexword(i+start),':');
  114.        end;
  115.     8: write(' ');
  116.     end;
  117.     write(hexbyte(bytes[i+start]):3);
  118.     if i mod 16 = $F then
  119.     begin
  120.       write('  ');
  121.       dumpascii($F);
  122.     end;
  123.   end;
  124.   if (num-1) mod 16 < $F then
  125.   begin
  126.     for j := num mod 16 to $f do
  127.     begin
  128.       write('   ');
  129.       if j = 8 then
  130.       write(' ');
  131.     end;
  132.     write('  ');
  133.     i := 16*((num-1) div 16) + $F;
  134.     dumpascii((num-1) mod 16);
  135.   end;
  136.   writeln;
  137. end;
  138.  
  139. procedure dumpwords(var loc;start,num:word);
  140. var
  141.   words:array[0..32760] of word absolute loc;
  142.   i:word;
  143. begin
  144.   if num = 0 then
  145.     exit;
  146.   repeat
  147.     write(hexword(start):4);
  148.     for i:=1 to minw(15,num) do
  149.       write(hexword(start+i):5);
  150.     writeln;
  151.     write(hexword(words[start]));
  152.     for i:=1 to minw(15,num) do
  153.       write(hexword(words[start+i]):5);
  154.     writeln;
  155.     inc(start,16);
  156.     dec(num,16);
  157.   until num > 65535 - 16;
  158. end;
  159.  
  160. end.
  161.